REM           > <StampIt$Dir>.!Runimage
REM Program   Time and Date file stamper
REM Version   0.01
REM Author    Tim Hill
REM HillSide  10 Nov 1990
REM Program   Subject to Copyright
 
DescriptiveTitle$ = "FileStamper"
Directory$        = "<StampIt$Dir>."
SpriteFile$       = "!Sprites"
SpriteName$       = "!StampIt"

PROCinit

Parameter$=FNOS_GetEnvParms
IF LEN(Parameter$)>0 THEN
      REM : process calling file
   ELSE
      REM : do nothing except install! - PROCinit
   ENDIF

REPEAT
  SYS Poll%,1,q% TO A%
  CASE A% OF
  WHEN 1 :PROCredraw_window(!q%)
  WHEN 2 :PROCopen_window(!q%,q%!4,q%!8,q%!12,q%!16,q%!20,q%!24,q%!28)
  WHEN 3 :PROCcloseawindow(!q%)
  WHEN 6 :PROCcheckmouse(!q%,q%!4,q%!8,q%!12,q%!16,q%!20)
  WHEN 9 :PROCmenuselect(q%)
  WHEN 17,18:PROCreceive(q%)
  ENDCASE
UNTIL FALSE

END
REM****************CORE PROCs**********************
:
DEF PROCredraw_window(handle%)
ENDPROC
:
DEF PROCreceive(q%)
CASE q%!16 OF
  WHEN 0:PROCfinish:END
  WHEN 3
    PROCStampFile(FNGetStr(q%+44),q%!40)
  ENDCASE
ENDPROC
:
DEFPROCmousewait(n)
LOCAL x%,y%,z%
REPEAT:MOUSE x%,y%,z%
UNTIL z%=n OR (n=-1 AND z%>0)
ENDPROC
:
DEF FNGetStr(s%) : REM get string
LOCAL n$
WHILE?s%:n$+=CHR$?s%:s%+=1:ENDWHILE
=n$
:
DEF PROCcheckmouse(mousex%,mousey%,b%,handle%,icon%,ob%)
IF(b%AND2)THEN
  CASE handle% OF
  WHEN -2
    PROCdomenu(101,"Quit",DescriptiveTitle$)
  ENDCASE
ENDIF
IF(b%AND4)THEN
   IF handle%>-1 THEN PROCgetw(handle%)
   CASE handle% OF
      WHEN -2 : REM clicked on icon
   ENDCASE
ENDIF
ENDPROC
:
DEF PROCerrorbox
SYS Drag,,-1
!buffer%=ERR:$(buffer%+4)=REPORT$+" at line "+STR$ERL+CHR$0
SYS "Wimp_ReportError",buffer%,1,DescriptiveTitle$
PROCfinish:END
ENDPROC
:
DEF PROCmessage(M$)
SYS Drag,,-1
!buffer%=ERR:$(buffer%+4)=M$
SYS "Wimp_ReportError",buffer%,1,DescriptiveTitle$
ENDPROC
:
REM -----------------------------------------------------------------
:
DEF PROCcloseawindow(handle%)
PROCgetw(handle%)
xo%=x0%:yo%=y0%:open%=FALSE
PROCclose_window(handle%)
ENDPROC
:
DEF PROCfinish
SYS "Wimp_CloseDown"
ENDPROC
:
DEF PROCdomenu(handle%,menu$,menutitle$)
menuhandle%=handle%
menuptr%=buffer%
i%=0
menuptr%!20=40
$menuptr%=menutitle$
menuptr%?12=`tfcol:menuptr%?13=2:menuptr%?14=`wfcol:menuptr%?15=`wbcol
menuptr%!16=196-24:menuptr%!24=0
menuptr%+=28
REPEAT item$=FNpar(","):PROCmenuitem(item$):UNTIL item$=""
menuptr%!-24=(menuptr%!-24)OR&80
SYS CrMenu,,buffer%,mousex%-64,96+80
ENDPROC
:
DEF PROCmenuitem(text$)
IF text$="" ENDPROC
!menuptr%=0
IF LEFT$(text$,1)=">" menuptr%!4=info% ELSE menuptr%!4=-1
menuptr%!8=&07000021
IF LEFT$(text$,1)=">" $(menuptr%+12)=MID$(text$,2) ELSE $(menuptr%+12)=text$
menuptr%+=24
ENDPROC
:
DEF FNpar(sep$)
i1%=i%+1:i%=INSTR(menu$+sep$,sep$,i1%)
=MID$(menu$,i1%,i%-i1%)
:
DEF PROCmenuselect(menus%)
SYS DcMenu,,buffer%,menus%,STRING$(200," ")TO,,,a$
IF a$="" THEN ENDPROC
CASE menuhandle% OF
WHEN 101:IF a$="Quit":PROCfinish:END
ENDCASE
ENDPROC
:
DEF PROCopen_window(handle%,x0%,y0%,x1%,y1%,scx%,scy%,bhandle%)
IFhandle%=-1THENENDPROC
q%!0=handle%:q%!28=bhandle%
q%!4=x0%:q%!8=y0%:q%!12=x1%:q%!16=y1%
q%!20=scx%:q%!24=scy%
SYS OpenW,,q%
ENDPROC
:
DEF PROCgetw(handle%)
!q%=handle%:SYS GetW,,q%
PROCinfo(q%+4):bhandle%=q%!28:flags%=q%!32
ENDPROC
:
DEF PROCinfo(q%)
x0%=!q%:y0%=q%!4:x1%=q%!8:y1%=q%!12:scx%=q%!16:scy%=q%!20
bx%=x0%-scx%:by%=y1%-scy%
ENDPROC
:
DEF PROCupdate(handle%,ux0%,uy0%,ux1%,uy1%)
!q%=handle%:q%!4=ux0%:q%!8=uy0%:q%!12=ux1%:q%!16=uy1%
SYS UpdateW,,q% TO more%:PROCinfo(q%+4)
ENDPROC
:
DEF PROCclose_window(handle%)
!q%=handle%:SYS CloseW,,q%
ENDPROC
:
DEF PROCvars
Wimp    = (1<<18) + (3<<6)
CreateW = Wimp+1
OpenW   = Wimp+5
CloseW  = Wimp+6
Poll%   = Wimp+7
RedrawW = Wimp+8
UpdateW = Wimp+9
GetR%   = Wimp+10
GetW    = Wimp+11
GetP    = Wimp+15
Drag    = Wimp+16
CrMenu  = Wimp+20
DcMenu  = Wimp+21
SYS "OS_SWINumberFromString",,"Wimp_SetColour" TO Col%
ENDPROC
:
DEF PROCgetpointer
SYS GetP,,q%
mousex%=!q%:mousey%=q%!4:b%=q%!8:handle%=q%!12:icon%=q%!16:ob%=q%!20
ENDPROC
:
DEF FNiconbar
!q%=-2:q%!4=0:q%!8=0:q%!12=63:q%!16=68:q%!20=&2102
DIM q%!24 (LENSpriteName$+1):$(q%!24)=SpriteName$:q%!28=sprites%
q%!32=LENSpriteName$+1
SYS "Wimp_CreateIcon",,q% TO ic%
=ic%
:
DEF PROCclear
errorflag%=FALSE:tempreg=0:entry$="0":operator$="=":dreg$=entry$
ENDPROC
:
REM -----------------------------------------------------------------
:
DEFPROCinit
DIM taskid%4:$taskid%="TASK"
SYS "Wimp_Initialise",200,!taskid%,DescriptiveTitle$ TO version%
`wbcol=10:`tbcol=12:`sco=4:`mbcol=2:`wfcol=&7:`tfcol=7:`sci=&D:`tbcol2=&C
PROCvars
DIM q% &300,buffer% &200
ONERROR PROCerrorbox
S%=OPENIN(Directory$+SpriteFile$):T%=EXT#S%+16:CLOSE#S%
DIM sprites% T%
!sprites%=T%:sprites%!8=1
SYS "OS_SpriteOp",&109,sprites%
SYS "OS_SpriteOp",&10A,sprites%, Directory$+SpriteFile$
iccalc%=FNiconbar:PROCclear
SYS Drag,,-1:PROCgetpointer:xo%=mousex%:yo%=mousey%:open%=FALSE
ENDPROC
:
DEF FNOS_GetEnvParms
LOCAL A$,J%,I%,result$
SYS"OS_GetEnv"TO A$
REM PRINT"Env :",A$
I%=INSTR(A$," -quit ")
IFI%THEN
   I%+=LEN" -quit "
   WHILEMID$(A$,I%,1)=" ":I%+=1:ENDWHILE
   I%=INSTR(A$+" "," ",I%+1)
   REPEATI%+=1:UNTILMID$(A$,I%,1)<>" "
   result$=MID$(A$,I%)
REM PRINT"Parameters :"result$
ENDIF
=result$
:
DEF PROCackload
q%!12=q%!8:q%!16=4:!q%=64
SYS "Wimp_SendMessage",17,q%,q%!4
ENDPROC
REM***************END CORE************************

DEF PROCStampFile(File$,Type%)
OSCLI"Stamp "+File$
ENDPROC
